C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C Note: txtbsz must be quite big as the buffer will not be filled
C       once it is within maxtoklen of the end of it, and maxtoklen
C       is approx 1300 characters!
C
C Note to installers: if the buffer sizes are too large for your
C     system then if you reduce them to something small (ie like
C     2000 characters) it is suggested that you redefine maxtoklen
C     (inside ISTFD only) to what you consider a reasonable max
C     size for a token, e.g. maxbuff).
C
C       ------------------------------------------------------------
C
C       Fortran Intelligent Difference Outputter
C
C       Malcolm Cohen, NAG Central Office, April 1984
C
C       Revised: February 1986
C
C       ------------------------------------------------------------
C
C                     F.I.D.O. Structure Chart
C                     ========================
C                     (NB: * = Duplicated Module)
C
C                     +------+
C                     | FIDO |
C                     +------+
C                        |
C         +---------+----+----+---------+---------+---------+
C         |         |         |         |         |         |
C     +-------+ +-------+ +-------+ +-------+ +-------+ +-------+
C     | FDARGS| | DOOPT | | INPUT | |*DIFRNT| | DODIF | | RESULT|
C     +-------+ +-------+ +---+---+ +-------+ +---+---+ +-------+
C                             |                   |
C                         +-------+               |
C                         |*RDTOK |               |
C                         +-------+               |
C                                                 |
C        +----------+-----------+----------------+-+
C        |          |           |                  |
C     +------+  +-------+   +-------+          +-------+
C     |ADJBUF|  | FILBUF|   | FNDDIF|          | REPDIF|
C     +------+  +---+---+   +---+---+          +---+---+
C                   |           |                  |
C               +-------+   +-------+              |
C               |*RDTOK |   | MATCH |      +-------+-+---------+
C               +-------+   +---+---+      |         |         |
C                               |      +-------+ +-------+ +-------+
C                           +-------+  | EXTRA | | OUTPOS| | OUTTOK|
C                           |*DIFRNT|  +-------+ +-------+ +-------+
C                           +-------+
C
C
C      +>>>>>>>>>>>>>FNDDIF calls ADVANC when in statement mode
C
C
C      ------------------------------------------------------------
 
        PROGRAM ISTFD
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
        INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
 
        COMMON/IN/TK1CTL,TK2CTL
        INTEGER TK1CTL,TK2CTL
 
        COMMON/ANSWER/CMTDIF,PRGDIF
        LOGICAL CMTDIF,PRGDIF
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
        SAVE
 
C Local function types
 
        LOGICAL DIFRNT
 
C
C       Local top-level storage
C
        INTEGER TK1PTH(81),CM1PTH(81),TK2PTH(81),
     +          CM2PTH(81),LSTPTH(81),OPTSTR(134)
C
C       Library routines called from top level
C
        INTEGER OPEN,CREATE,GETARG,ZTKGTI
        EXTERNAL OPEN,CREATE,GETARG,ERROR,ZINIT,ZQUIT,ZTKGTI,REMARK
C
C
C       T O P     L E V E L
C
C
C       Initialise TIE
        CALL ZINIT
 
C       Read paths from command file
 
        IF (GETARG(1,TK1PTH,81).EQ.-100) CALL FDARGS(1,TK1PTH)
        IF (GETARG(2,CM1PTH,81).EQ.-100) CALL FDARGS(2,CM1PTH)
        IF (GETARG(3,TK2PTH,81).EQ.-100) CALL FDARGS(3,TK2PTH)
        IF (GETARG(4,CM2PTH,81).EQ.-100) CALL FDARGS(4,CM2PTH)
        IF (GETARG(5,LSTPTH,81).EQ.-100) CALL FDARGS(5,LSTPTH)
        IF (GETARG(6,OPTSTR,134).EQ.-100) CALL FDARGS(6,OPTSTR)
 
C       Set up option flags -- set up defaults first
C       (With NMATCH, we set it up so that we can choose the default
C        setting according to the TKMODE option - ie 3 statements or
C        7 tokens)
 
        LSTDIF=.TRUE.
        CHKCMT=.FALSE.
        TKMODE=.TRUE.
        NMATCH=-1
        CALL DOOPT(OPTSTR)
        IF (NMATCH.LT.1) THEN
            IF (TKMODE) THEN
                NMATCH=7
            ELSE
                NMATCH=3
            END IF
        END IF
 
C       Open required files
 
        IODTK1=OPEN(TK1PTH,0)
        IF (IODTK1.EQ.-1)
     +      CALL ERROR('ISTFD unable to open token path 1')
        IODCM1=OPEN(CM1PTH,0)
        IF (IODCM1.EQ.-1)
     +      CALL ERROR('ISTFD unable to open cmt path 1')
        IODTK2=OPEN(TK2PTH,0)
        IF (IODTK2.EQ.-1)
     +      CALL ERROR('ISTFD unable to open token path 2')
        IODCM2=OPEN(CM2PTH,0)
        IF (IODCM2.EQ.-1)
     +      CALL ERROR('ISTFD unable to open cmt path 2')
        IF (LSTDIF) THEN
            IODLST=CREATE(LSTPTH,1)
            IF (IODLST.EQ.-1)
     +          CALL ERROR('ISTFD unable to open list path')
        END IF
 
C       Initialise token streams
 
        TK1CTL = ZTKGTI(1, IODTK1,IODCM1)
        TK2CTL = ZTKGTI(1, IODTK2,IODCM2)
        IF (TK1CTL.LE.0)
     +      CALL ERROR('ISTFD unable to init token stream 1')
        IF (TK2CTL.LE.0)
     +      CALL ERROR('ISTFD unable to init token stream 2')
 
C       Initialise the buffer pointers, result flags, token counts
 
        TB1CUR=1
        TB1TOP=1
        TX1CUR=0
        TX1TOP=0
        TB2CUR=1
        TB2TOP=1
        TX2CUR=0
        TX2TOP=0
        NUNIT1=0
        NUNIT2=0
        CMTDIF=.FALSE.
        PRGDIF=.FALSE.
C   Pretend that an EOS precedes each file
        TB1TYP(TB1CUR)=TZEOS
        TB2TYP(TB2CUR)=TZEOS
 
C       And finally process the files
 
        CALL INPUT
 1000   IF (DIFRNT(TB1CUR,TB2CUR)) THEN
            CALL DODIF
        ELSE
            CALL INPUT
        END IF
        IF (LASTB1.NE.TZEOF.OR.LASTB2.NE.TZEOF) GO TO 1000
        CALL RESULT(CMTDIF,PRGDIF)
 
        CALL REMARK('[ISTFD Normal Termination]')
        CALL ZQUIT(-2)
 
        END
C ----------------------------------------------------------------------
C
C       F D A R G S   -   Input ISTFD command arguments from the user
C
 
        SUBROUTINE FDARGS(NUMB,PATH)
        INTEGER NUMB,PATH(*)
 
        INTEGER I,PROMPT(21,6)
 
        SAVE PROMPT
 
        INTEGER ZGTCMD
        EXTERNAL ZGTCMD,ZPRMPT
 
        DATA (PROMPT(I,1),I=1,15)/84,111,107,101,110,32,102,
     +                      105,108,101,32,49,58,32,129/
     +(PROMPT(I,2),I=1,17)/67,111,109,109,101,110,116,32,
     +                 102,105,108,101,32,49,58,32,129/
     +(PROMPT(I,3),I=1,15)/84,111,107,101,110,32,102,105,
     +                 108,101,32,50,58,32,129/
     +(PROMPT(I,4),I=1,17)/67,111,109,109,101,110,116,32,
     +                 102,105,108,101,32,50,58,32,129/
     +(PROMPT(I,5),I=1,15)/76,105,115,116,105,110,103,32,
     +                 102,105,108,101,58,32,129/
     +(PROMPT(I,6),I=1,21)/80,114,111,99,101,115,115,105,110,
     +  103,32,111,112,116,105,111,110,115,58,32,129/
 
 
        CALL ZPRMPT(PROMPT(1,NUMB))
        I=ZGTCMD(PATH,0)
 
        END
C ----------------------------------------------------------------------
C
C       D O O P T   -   Decode the option string
C
 
        SUBROUTINE DOOPT(OPTSTR)
        INTEGER OPTSTR(*)
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        INTEGER OPTTBL(43),YESNOX(8),MODE(17),STRING(134),POINT
        INTEGER LHS(134),RHS(134),OPTION,OPTARG
 
        SAVE /OPTS/,OPTTBL,YESNOX,MODE
 
        INTEGER GETWRD,ZKWLUK,CTOI,ZSPLIT,ALLDIG
        EXTERNAL GETWRD,ZCHOUT,PUTLIN,ZMESS,ZKWLUK,CTOI,ZSPLIT,SCOPY,
     +           ALLDIG
 
        DATA OPTTBL/6,
     +      99,111,109,109,101,110,116,95,99,104,101,
     +99,107,129,
     +      108,105,115,116,129,
     +      109,111,100,101,129,
     +      110,109,97,116,99,104,129,
     +      110,111,110,101,129,
     +      113,117,105,99,107,129/
        DATA YESNOX/2,
     +      121,101,115,129,
     +      110,111,129/,
     +       MODE/2,
     +      115,116,97,116,101,109,101,110,116,129,
     +      116,111,107,101,110,129/
 
        POINT=1
 
 100    IF (GETWRD(OPTSTR,POINT,STRING).EQ.0) RETURN
        IF (ZSPLIT(STRING,LHS,RHS).NE.-2) THEN
            CALL SCOPY(STRING,1,LHS,1)
            RHS(1)=129
        END IF
        OPTION=ZKWLUK(LHS,OPTTBL)
        IF (OPTION.LE.0) THEN
            IF (OPTION.EQ.0) CALL ZCHOUT('Warning: Ambiguous',2)
            IF (OPTION.EQ.-1)  CALL ZCHOUT('Warning: Unknown',2)
            CALL ZCHOUT(' Option "',2)
            CALL PUTLIN(LHS,2)
            CALL ZMESS('" Ignored',2)
        ELSE IF (OPTION.EQ.1.OR.OPTION.EQ.2) THEN
            IF (RHS(1).EQ.129) THEN
C set up default of "yes" if just "comment_check" or "list" input
                RHS(1)=121
                RHS(2)=129
                CALL ZCHOUT('Warning: Missing Argument to option: "',
     +                      2)
                CALL PUTLIN(LHS,2)
                CALL ZMESS('" - assuming "Yes"',2)
            END IF
            OPTARG=ZKWLUK(RHS,YESNOX)
            IF (OPTARG.LE.0) THEN
                CALL ZCHOUT('Warning: Bad Argument to option: "',2)
                CALL PUTLIN(STRING,2)
                CALL ZMESS('" : Ignored',2)
            ELSE IF (OPTION.EQ.1) THEN
                CHKCMT=OPTARG.EQ.1
            ELSE
                LSTDIF=OPTARG.EQ.1
            END IF
        ELSE IF (OPTION.EQ.3) THEN
            OPTARG=ZKWLUK(RHS,MODE)
            IF (OPTARG.LE.0) THEN
                CALL ZCHOUT('Warning: Bad Argument to option: "',
     +                      2)
                CALL PUTLIN(LHS,2)
                CALL PUTCH(61,2)
                CALL PUTLIN(RHS,2)
                CALL ZMESS('" : Ignored',2)
            ELSE
                TKMODE=(OPTARG.EQ.2)
            END IF
        ELSE IF (OPTION.EQ.4) THEN
            IF (ALLDIG(RHS).NE.-2) THEN
                CALL REMARK('Warning: No Numerical Argument for NMATCH')
            ELSE
                OPTARG=1
                NMATCH=CTOI(RHS,OPTARG)
            END IF
        ELSE IF (OPTION.EQ.6) THEN
            IF (RHS(1).NE.129) CALL REMARK(
     +'Warning: Unexpected argument to the QUICK option - ignored')
            LSTDIF=.FALSE.
            TKMODE=.TRUE.
        END IF
        GOTO 100
 
        END
C ----------------------------------------------------------------------
C
C       I N P U T   -   Input routine.
C
C       Buffered input routine.  It doesn't fill the buffers - it only
C       empties them.  Once they are empty, it will read one token (or
C       statement, if in statement mode) at a time into the front of the
C       buffer.
C
C       Begins with TBnCUR pointing to the last token (or first token of
C       last statement) processed.
C
C       Returns with TBnCUR pointing to next tokens
C
 
        SUBROUTINE INPUT
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/IN/TK1CTL,TK2CTL
        INTEGER TK1CTL,TK2CTL
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
        INTEGER NMATCH
 
        SAVE /BUFS/,/IN/,/OPTS/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
C Lookahead variable for statement mode processing
        INTEGER LUKAHD
 
        LOGICAL ENDSTM
        EXTERNAL ENDSTM
 
C Set one-token lookback for intelligent token display etc.
 100    IF (TKMODE) THEN
            LASTB1=TB1TYP(TB1CUR)
        ELSE
C Statement mode: skip to end of statement
 110        IF (TB1CUR.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(TB1CUR))) THEN
                TB1CUR=TB1CUR+1
                IF (TB1PTR(TB1CUR).NE.0) TX1CUR=TB1PTR(TB1CUR)
                GOTO 110
            ELSE
                LASTB1=TB1TYP(TB1CUR)
            END IF
        END IF
C Now advance to next (token|statement)/read in next (token|statement)
        IF (TB1CUR.NE.TB1TOP) THEN
            TB1CUR=TB1CUR+1
            NUNIT1=NUNIT1+1
            IF (TB1PTR(TB1CUR).NE.0) TX1CUR=TB1PTR(TB1CUR)
C If statement mode: must make sure an entire statement is in the buffer,
C and read in the remainder if it is not so.
            IF (.NOT.TKMODE) THEN
                LUKAHD=TB1CUR
 120            IF(LUKAHD.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(LUKAHD)))THEN
                    LUKAHD=LUKAHD+1
                    GOTO 120
                END IF
                IF (.NOT.ENDSTM(TB1TYP(LUKAHD))) THEN
                    CALL ADJBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,
     +                          TB1TOP,TX1CUR,TX1TOP,1)
 130                CALL RDTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP
     +                         ,TK1CTL)
                    IF (.NOT.ENDSTM(TB1TYP(TB1TOP))) GOTO 130
                END IF
            END IF
        ELSE
            TB1CUR=1
            TB1TOP=0
            TX1CUR=1
            TX1TOP=0
            IF (LASTB1.EQ.TZEOF) THEN
                TB1TYP(1)=TZEOF
            ELSE
 150            CALL RDTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP,
     +                     TK1CTL)
                IF (.NOT.(TKMODE.OR.ENDSTM(TB1TYP(TB1TOP))).AND.
     +              TB1TOP.LT.700) GOTO 150
                NUNIT1=NUNIT1+1
            END IF
        END IF
        IF (TB1TYP(TB1CUR).EQ.TCMMNT.AND..NOT.CHKCMT) GOTO 100
 200    IF (TKMODE) THEN
            LASTB2=TB2TYP(TB2CUR)
        ELSE
 210        IF (TB2CUR.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(TB2CUR))) THEN
                TB2CUR=TB2CUR+1
                IF (TB2PTR(TB2CUR).NE.0) TX2CUR=TB2PTR(TB2CUR)
                GOTO 210
            ELSE
                LASTB2=TB2TYP(TB2CUR)
            END IF
        END IF
        IF (TB2CUR.NE.TB2TOP) THEN
            TB2CUR=TB2CUR+1
            NUNIT2=NUNIT2+1
            IF (TB2PTR(TB2CUR).NE.0) TX2CUR=TB2PTR(TB2CUR)
            IF (.NOT.TKMODE) THEN
                LUKAHD=TB2CUR
 220            IF(LUKAHD.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(LUKAHD)))THEN
                    LUKAHD=LUKAHD+1
                    GOTO 220
                END IF
                IF (.NOT.ENDSTM(TB2TYP(LUKAHD))) THEN
                    CALL ADJBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,
     +                          TB2TOP,TX2CUR,TX2TOP,1)
 230                CALL RDTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP
     +                         ,TK2CTL)
                    IF (TB2TOP.LT.700.AND..NOT.ENDSTM(TB2TYP(TB2TOP))
     +              ) GOTO 230
                END IF
            END IF
       ELSE
            TB2CUR=1
            TB2TOP=0
            TX2CUR=1
            TX2TOP=0
            IF (LASTB2.EQ.TZEOF) THEN
                TB2TYP(1)=TZEOF
            ELSE
 250            CALL RDTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP,
     +                     TK2CTL)
                IF (TB2TOP.LT.700.AND..NOT.(ENDSTM(TB2TYP(TB2TOP))
     +              .OR.TKMODE)) GOTO 250
                NUNIT2=NUNIT2+1
            END IF
        END IF
        IF (TB2TYP(TB2CUR).EQ.TCMMNT.AND..NOT.CHKCMT) GOTO 200
        RETURN
        END
 
 
C ----------------------------------------------------------------------
C
C       E N D S T M   -   Treat this token as end-of-statement?
C                         (i.e. TZEOS/TZEOF/TCMMNT)
C
 
        LOGICAL FUNCTION ENDSTM(TYPE)
        INTEGER TYPE
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        ENDSTM=(TYPE.EQ.TZEOS .OR. TYPE.EQ.TZEOF .OR. TYPE.EQ.TCMMNT)
 
        END
C ----------------------------------------------------------------------
C
C       R D T O K   -   Read token into a buffer.
C
 
        SUBROUTINE RDTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,NEXT,TXTTOP,CNTRL)
        INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),NEXT,TXTTOP,
     +          CNTRL, STATUS
 
        NEXT=NEXT+1
 100    CALL ZGETTK(TYPBUF(NEXT),LENBUF(NEXT),TXTBUF(TXTTOP+1),
     +              CNTRL, STATUS)
        IF (STATUS.NE.-2)
     +     CALL ERROR('ISTFD Internal Error - Token Read Failed')
        IF (LENBUF(NEXT).GT.0) THEN
            PTRBUF(NEXT)=TXTTOP+1
            TXTTOP=TXTTOP+LENBUF(NEXT)
        ELSE
            PTRBUF(NEXT)=0
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       D I F R N T   -   Compare two items, which may be either tokens
C                         or statements, for non-equality.
C
C       When in Statement Mode:
C           If either or both of the token streams in the buffer run out
C           before we detect an end of statement, then we will consider
C           the two statements as being DIFFERENT (as we cannot be sure
C           that they are the same).
C
 
        LOGICAL FUNCTION DIFRNT(P1,P2)
        INTEGER P1,P2
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        LOGICAL DIFTOK,ENDSTM
        EXTERNAL DIFTOK,ENDSTM
 
        SAVE /BUFS/,/OPTS/
 
        INTEGER I
 
        IF (TKMODE) THEN
            DIFRNT=DIFTOK(P1,P2)
        ELSE
            I=0
 100        IF (DIFTOK(P1+I,P2+I)) THEN
                DIFRNT=.TRUE.
            ELSE
C Statements are the same so far: see if that is the end
                IF (ENDSTM(TB1TYP(P1+I))) THEN
                    DIFRNT=.FALSE.
C ... or see if we have run out of one of them
                ELSE IF (P1+I.EQ.TB1TOP .OR. P2+I.EQ.TB2TOP) THEN
                    DIFRNT=.TRUE.
                ELSE
C ... Not finished and still more to go: so keep going
                    I=I+1
                    GOTO 100
                END IF
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       D I F T O K   -   Are two tokens different?
C
 
        LOGICAL FUNCTION DIFTOK(P1,P2)
        INTEGER P1,P2
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        INTEGER I
 
        SAVE /BUFS/
 
        DIFTOK=.TRUE.
        IF (TB1TYP(P1).EQ.TB2TYP(P2) .AND.
     +      TB1LEN(P1).EQ.TB2LEN(P2)) THEN
            DIFTOK=.FALSE.
            IF (TB1LEN(P1).NE.0) THEN
                DO 100 I=0,TB1LEN(P1)-1
                    IF (TB1TXT(TB1PTR(P1)+I).NE.TB2TXT(TB2PTR(P2)+I))
     +                  DIFTOK=.TRUE.
 100            CONTINUE
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       D O D I F   -   Process a difference which has been detected
C
C       This routine sets up the conditions for the difference finding
C       and then calls the FNDDIF and REPDIF routines to do the actual
C       finding and reporting of the difference.
C       This setup consists of calling the appropriate routines to fix
C       up the internal buffers.
C
 
        SUBROUTINE DODIF
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/IN/TK1CTL,TK2CTL
        INTEGER TK1CTL,TK2CTL
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        SAVE /BUFS/,/IN/,/OPTS/
 
        INTEGER I,P
 
        IF (TB1CUR.NE.1)
     +      CALL ADJBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,
     +                  TX1CUR,TX1TOP,1)
        IF (TB2CUR.NE.1)
     +      CALL ADJBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +                  TX2CUR,TX2TOP,1)
        CALL FILBUF(TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1TOP,TX1TOP,TK1CTL)
        CALL FILBUF(TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2TOP,TX2TOP,TK2CTL)
        CALL FNDDIF
        CALL REPDIF
        IF (TKMODE) THEN
            NUNIT1=NUNIT1+TB1CUR-1
            NUNIT2=NUNIT2+TB2CUR-1
        ELSE
            P=1
            I=0
 100        IF (P.LT.TB1CUR) THEN
                CALL ADVANC(P,TB1TYP,TB1TOP)
                I=I+1
                GOTO 100
            END IF
            NUNIT1=NUNIT1+I
            P=1
            I=0
 200        IF (P.LT.TB2CUR) THEN
                CALL ADVANC(P,TB2TYP,TB2TOP)
                I=I+1
                GOTO 200
            END IF
            NUNIT2=NUNIT2+I
        END IF
        LASTB1=TB1TYP(TB1CUR)
        LASTB2=TB2TYP(TB2CUR)
 
        END
C ----------------------------------------------------------------------
C
C       A D J B U F   -   Adjust buffer so that current is at the top.
C
C       This routine shifts the portion of a token buffer from CURENT
C       to TOP down to BOTTOM, and adjusts CURENT and TOP accordingly.
C       It also compacts the associated text buffer.
C
 
        SUBROUTINE ADJBUF(TYPBUF,LENBUF,PTRBUF,TXTBUF,CURENT,TOP,TXCURR
     +                    ,TXTTOP,BOTTOM)
        INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),CURENT,TOP,
     +          TXCURR,TXTTOP,BOTTOM
 
        INTEGER I
 
        DO 100 I=BOTTOM,TOP-CURENT+BOTTOM
            TYPBUF(I)=TYPBUF(I+CURENT-BOTTOM)
            PTRBUF(I)=PTRBUF(I+CURENT-BOTTOM)
            IF (PTRBUF(I).NE.0) PTRBUF(I)=PTRBUF(I)-TXCURR+1
100         LENBUF(I)=LENBUF(I+CURENT-BOTTOM)
        TOP=TOP-CURENT+BOTTOM
        CURENT=BOTTOM
 
C Now shift text about if necessary (already changed pointers)
 
        IF (TXCURR.GT.1) THEN
            DO 200 I=1,TXTTOP-TXCURR+1
 200        TXTBUF(I)=TXTBUF(I+TXCURR-1)
            TXTTOP=TXTTOP-TXCURR+1
            TXCURR=1
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       F I L B U F   -   Fill input buffer
C
C       This routine fills an input buffer until it is in danger of
C       overflowing.
C
 
        SUBROUTINE FILBUF(TYPBUF,LENBUF,PTRBUF,TXTBUF,TOP,TXTTOP,CNTRL)
        INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),TOP,TXTTOP,CNTRL
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
C Assumes that the buffer already has at least one token in it
 
 100    IF (TYPBUF(TOP).NE.TZEOF .AND. TOP.LT.700 .AND.
     +      TXTTOP.LT.4000-1322) THEN
            CALL RDTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,TOP,TXTTOP,CNTRL)
            GO TO 100
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       F N D D I F   -   Find difference
C
C       Discovers the extent of the difference and sets the buffer
C       pointers to the end of it.
C
C Note: Assumes that both buffers are adjusted and filled.
C
 
        SUBROUTINE FNDDIF
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        SAVE /BUFS/,/OPTS/
 
        INTEGER I,P1,P2
 
C Logical function MATCH
        LOGICAL MATCH
 
        EXTERNAL REMARK
 
        IF (TB1TOP.EQ.1 .OR. TB2TOP.EQ.1) THEN
C We must have hit an end of file - a buffer is almost empty
            TB1CUR=TB1TOP
            TB2CUR=TB2TOP
            RETURN
        END IF
        IF (TKMODE) THEN
C ===========================================TOKEN MODE
            DO 250 I=2,MAX(TB1TOP,TB2TOP)
                IF (TB2TOP.GE.I) THEN
                    TB2CUR=I
                    DO 100 TB1CUR=1,MIN(TB1TOP-NMATCH+1,I)
                        IF (MATCH()) RETURN
 100                CONTINUE
                END IF
                IF (TB1TOP.GE.I) THEN
C       "I-1" in this loop as the (I,I) comparison done in previous loop
                    TB1CUR=I
                    DO 200 TB2CUR=1,MIN(TB2TOP-NMATCH+1,I-1)
                        IF (MATCH()) RETURN
 200                CONTINUE
                END IF
 250        CONTINUE
        ELSE
C ===========================================STATEMENT MODE
            P1=1
            P2=1
            CALL ADVANC(P1,TB1TYP,TB1TOP)
            CALL ADVANC(P2,TB2TYP,TB2TOP)
 500        IF (TB2TOP.GE.P2) THEN
                TB2CUR=P2
                TB1CUR=1
 600            IF (MATCH()) RETURN
                CALL ADVANC(TB1CUR,TB1TYP,TB1TOP)
                IF (TB1CUR.LE.MIN(TB1TOP-NMATCH+1,P1)) GOTO 600
            END IF
            IF (TB1TOP.GE.P1) THEN
                TB1CUR=P1
                TB2CUR=1
 700            IF (MATCH()) RETURN
                CALL ADVANC(TB2CUR,TB2TYP,TB2TOP)
C (P2-1) here as the (P1,P2) comparison already done above
                IF (TB2CUR.LE.MIN(TB2TOP-NMATCH+1,P2-1)) GOTO 700
            END IF
            CALL ADVANC(P1,TB1TYP,TB1TOP)
            CALL ADVANC(P2,TB2TYP,TB2TOP)
            IF (P1.LT.TB1TOP.OR.P2.LT.TB2TOP) GOTO 500
        END IF
C ===========================================END OF STATEMENT MODE
        IF (TB1TYP(TB1TOP).NE.TZEOF .OR. TB2TYP(TB2TOP).NE.TZEOF)
     +CALL REMARK('Warning: The programs look completely different')
        TB1CUR=TB1TOP
        TB2CUR=TB2TOP
 
        END
C ----------------------------------------------------------------------
C
C       A D V A N C   -   Advance pointer to beginning of next statement
C                       :if end of buffer encountered, TOP+1 is returned
C
        SUBROUTINE ADVANC(P,TYPE,TOP)
        INTEGER P,TYPE(*),TOP
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        LOGICAL ENDSTM
        EXTERNAL ENDSTM
 
 100    P=P+1
        IF (P.LE.TOP.AND..NOT.ENDSTM(TYPE(P-1))) GOTO 100
        IF (.NOT.ENDSTM(TYPE(P-1))) P=TOP+1
 
        END
C -----------------------------------------------------------------------
C
C       M A T C H   -   See if we have found a match which ends the
C                       difference at (TB1CUR,TB2CUR)
C
 
        LOGICAL FUNCTION MATCH()
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        SAVE /BUFS/,/OPTS/
 
        INTEGER N,N1,N2
 
C Local logical function:
        LOGICAL DIFRNT,ENDSTM
 
        MATCH=.FALSE.
        IF (DIFRNT(TB1CUR,TB2CUR)) RETURN
        N1=TB1CUR+1
        N2=TB2CUR+1
        DO 500 N=2,NMATCH
            IF (.NOT.CHKCMT) THEN
 100            IF (TB1TYP(N1).EQ.TCMMNT.AND.N1.LT.TB1TOP) THEN
                    N1=N1+1
                    GOTO 100
                END IF
 200            IF (TB2TYP(N2).EQ.TCMMNT.AND.N2.LT.TB2TOP) THEN
                    N2=N2+1
                    GOTO 200
                END IF
            END IF
            IF (.NOT.TKMODE) THEN
 300            IF (N1.LT.TB1TOP.AND..NOT.ENDSTM(TB1TYP(N1-1))) THEN
                    N1=N1+1
                    GOTO 300
                END IF
 400            IF (N2.LT.TB2TOP.AND..NOT.ENDSTM(TB2TYP(N2-1))) THEN
                    N2=N2+1
                    GOTO 400
                END IF
            END IF
            IF (DIFRNT(N1,N2)) RETURN
            IF (N1.LT.TB1TOP) N1=N1+1
            IF (N2.LT.TB2TOP) N2=N2+1
 500    CONTINUE
        MATCH=.TRUE.
 
        END
C ------------------------------------------------------------------------
C
C       R E P D I F   -   Report the difference found
C
 
        SUBROUTINE REPDIF
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/BUFS/TB1TYP,TB1LEN,TB1PTR,TB1TXT,TB1CUR,TB1TOP,TX1CUR,
     +              TX1TOP,TB2TYP,TB2LEN,TB2PTR,TB2TXT,TB2CUR,TB2TOP,
     +              TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
        INTEGER TB1TYP(700),TB1LEN(700),TB1PTR(700),TB1CUR,
     +          TB1TXT(4000),TB2TYP(700),TB2LEN(700),TB1TOP,
     +          TB2PTR(700),TB2TXT(4000),TX1CUR,TX1TOP,TB2CUR,
     +          TB2TOP,TX2CUR,TX2TOP,NUNIT1,NUNIT2,LASTB1,LASTB2
 
        COMMON/ANSWER/CMTDIF,PRGDIF
        LOGICAL CMTDIF,PRGDIF
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
        INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
 
        SAVE /BUFS/,/ANSWER/,/OPTS/,/IO/
 
        INTEGER I,LIM1,LIM2
 
        EXTERNAL EXTRA,OUTPOS,OUTTOK
 
        EXTERNAL ZMESS
 
        DO 100 I=1,TB1CUR-1
            IF (TB1TYP(I).NE.TCMMNT) PRGDIF=.TRUE.
 100    CONTINUE
        DO 200 I=1,TB2CUR-1
            IF (TB2TYP(I).NE.TCMMNT) PRGDIF=.TRUE.
 200    CONTINUE
        CMTDIF=.NOT.PRGDIF
        IF (LSTDIF) THEN
            LIM1=TB1CUR
            LIM2=TB2CUR
            IF (.NOT.TKMODE) THEN
 300            IF (LIM1.LT.TB1TOP .AND. TB1TYP(LIM1).NE.TZEOS .AND.
     +            TB1TYP(LIM1).NE.TZEOF.AND.TB1TYP(LIM1).NE.TCMMNT) THEN
                    LIM1=LIM1+1
                    GOTO 300
                END IF
 400            IF (LIM2.LT.TB2TOP .AND. TB2TYP(LIM2).NE.TZEOS .AND.
     +            TB2TYP(LIM2).NE.TZEOF.AND.TB2TYP(LIM2).NE.TCMMNT) THEN
                    LIM2=LIM2+1
                    GOTO 400
                END IF
            END IF
            IF (TB1CUR.EQ.1) THEN
                CALL EXTRA(2,NUNIT2,TB2CUR,NUNIT1,TB1TOP.EQ.1)
                CALL OUTTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,LIM2,LASTB2)
            ELSE IF (TB2CUR.EQ.1) THEN
                CALL EXTRA(1,NUNIT1,TB1CUR,NUNIT2,TB2TOP.EQ.1)
                CALL OUTTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,LIM1,LASTB1)
            ELSE
                IF (TKMODE) THEN
                   CALL ZMESS('Programs have differing tokens:',IODLST)
                ELSE
                   CALL ZMESS('Programs have differing statements:',
     +                        IODLST)
                END IF
                CALL OUTPOS(1,NUNIT1)
                CALL OUTTOK(TB1TYP,TB1LEN,TB1PTR,TB1TXT,LIM1,LASTB1)
                CALL OUTPOS(2,NUNIT2)
                CALL OUTTOK(TB2TYP,TB2LEN,TB2PTR,TB2TXT,LIM2,LASTB2)
            END IF
            CALL ZMESS('- - - - - - - - - - - - - - - - -',IODLST)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       E X T R A   -   Output appropriate message for extra code found
C
C       In token mode, this routine outputs the message
C           "Extra token in program # at token #
C                       (before token # of program #)"
C      or
C           "Extra tokens in program # at tokens # to #
C                     (before token # of program #)"
C       to the listing file.
C
C       In statement mode, the message
C           "Extra statement(s) in program # at statement #
C                       (before statement # of program #)"
C       is output.
C
        SUBROUTINE EXTRA(FILNUM,NUNITF,LIM,NTKO,EOF)
        INTEGER FILNUM,NUNITF,LIM,NTKO
        LOGICAL EOF
 
        COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
        INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        SAVE /IO/,/OPTS/
 
        EXTERNAL ZCHOUT,ZPTINT,ZMESS
 
        IF (LIM.EQ.2 .AND. TKMODE) THEN
            CALL ZCHOUT('Extra token in program ',IODLST)
            CALL ZPTINT(FILNUM,1,IODLST)
            CALL ZCHOUT(' at token ',IODLST)
        ELSE IF (TKMODE) THEN
            CALL ZCHOUT('Extra tokens in program ',IODLST)
            CALL ZPTINT(FILNUM,1,IODLST)
            CALL ZCHOUT(' at tokens ',IODLST)
        ELSE
            CALL ZCHOUT('Extra statement(s) in program ',IODLST)
            CALL ZPTINT(FILNUM,1,IODLST)
            CALL ZCHOUT(' at statement ',IODLST)
        END IF
        CALL ZPTINT(NUNITF,1,IODLST)
        IF (LIM.GT.2 .AND. TKMODE) THEN
            CALL ZCHOUT(' to ',IODLST)
            CALL ZPTINT(NUNITF+LIM-1,1,IODLST)
        END IF
        IF (TKMODE) THEN
            CALL ZCHOUT(' (before token ',IODLST)
        ELSE
            IF (EOF) THEN
              CALL ZCHOUT(' (at end ',IODLST)
            ELSE
              CALL ZCHOUT(' (before statement ',IODLST)
            ENDIF
        END IF
        IF (.NOT.EOF) CALL ZPTINT(NTKO,1,IODLST)
        CALL ZCHOUT(' of program ',IODLST)
        CALL ZPTINT(3-FILNUM,1,IODLST)
        CALL ZMESS(')',IODLST)
 
        END
C ----------------------------------------------------------------------
C
C       O U T T O K   -   Display tokens to user
C
C       This routine lists the tokens in the buffer passed from 1 up to
C       LIM onto the listing file.
C       If the token before the difference is not an end-of-statement or
C       a comment, then '...' is output to the listing to indicate that
C       the tokens are starting in the middle of a statement.
C       Similiarly with the end of the difference.
C
 
        SUBROUTINE OUTTOK(TYPBUF,LENBUF,PTRBUF,TXTBUF,LIM,LAST)
        INTEGER TYPBUF(*),LENBUF(*),PTRBUF(*),TXTBUF(*),LIM,LAST,JUNK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
        INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
 
        SAVE /IO/
 
        INTEGER I,STRING(134)
 
        INTEGER ZTOKTX
        EXTERNAL ZMESS,PUTLIN,PUTCH,ZTOKTX
 
        IF (LAST.NE.TZEOS .AND. LAST.NE.TCMMNT)
     +      CALL ZCHOUT(' ......',IODLST)
        DO 100 I=1,LIM
            IF (LENBUF(I).EQ.0) THEN
              JUNK = ZTOKTX(TYPBUF(I),LENBUF(I),TXTBUF(1),STRING)
            ELSE
              IF (LENBUF(I).GT.132-4) THEN
                TXTBUF(PTRBUF(I)+132-5)=129
                LENBUF(I)=132-4
                CALL REMARK('Warning: long token truncated')
              END IF
              JUNK=ZTOKTX(TYPBUF(I),LENBUF(I),TXTBUF(PTRBUF(I)),STRING)
            END IF
            CALL PUTLIN(STRING,IODLST)
            IF (TYPBUF(I).EQ.TCMMNT .OR. TYPBUF(I).EQ.TZEOS .OR.
     +          TYPBUF(I).EQ.TZEOF) THEN
                CALL PUTCH(10,IODLST)
            ELSE IF (LENBUF(I).NE.0) THEN
                CALL PUTCH(32,IODLST)
            END IF
 100    CONTINUE
        IF (TYPBUF(LIM).NE.TZEOF .AND. TYPBUF(LIM).NE.TZEOS.AND.
     +      TYPBUF(LIM).NE.TCMMNT) CALL ZMESS(' ......',IODLST)
 
        END
C ----------------------------------------------------------------------
C
C       O U T P O S   -   Display position within input file.
C
C       This routine outputs "Program # at token #" to the listing file.
C       (In statement mode, "token" is replaced by "statement").
C
 
        SUBROUTINE OUTPOS(FILNUM,NUNITF)
        INTEGER FILNUM,NUNITF
 
        COMMON/IO/IODTK1,IODCM1,IODTK2,IODCM2,IODLST
        INTEGER IODTK1,IODCM1,IODTK2,IODCM2,IODLST
 
        COMMON/OPTS/LSTDIF,CHKCMT,TKMODE,NMATCH
        INTEGER NMATCH
        LOGICAL LSTDIF,CHKCMT,TKMODE
 
        SAVE /IO/,/OPTS/
 
        EXTERNAL ZPTINT,ZCHOUT,ZMESS
 
        CALL ZCHOUT('Program ',IODLST)
        CALL ZPTINT(FILNUM,1,IODLST)
        IF (TKMODE) THEN
            CALL ZCHOUT(' at token ',IODLST)
        ELSE
            CALL ZCHOUT(' at statement ',IODLST)
        END IF
        IF (NUNITF.EQ.0) THEN
            CALL ZPTINT(0,1,IODLST)
        ELSE
            CALL ZPTINT(NUNITF,1,IODLST)
        END IF
        CALL ZMESS(':',IODLST)
 
        END
C ----------------------------------------------------------------------
C
C       R E S U L T   -   Describe result of entire comparison.
C
 
        SUBROUTINE RESULT(CMTDIF,PRGDIF)
        LOGICAL CMTDIF,PRGDIF
 
        EXTERNAL ZMESS
 
        IF (PRGDIF) THEN
            CALL ZMESS('Programs are different',1)
        ELSE IF (CMTDIF) THEN
            CALL ZMESS('Only changes in comment lines encountered',1)
        ELSE
            CALL ZMESS('No meaningful differences encountered',1)
        END IF
 
        END
